home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / fin_tp.exe / FINANCE.PAS
Pascal/Delphi Source File  |  1990-01-20  |  7KB  |  193 lines
  1. {==============================================================}
  2. {               Saved as: FINANCE.PAS                          }
  3. {                 Author: Pat Anderson                         }
  4. {                Purpose: Service routines for loan            }
  5. {                         payment and amortization             }
  6. {                         program                              }
  7. {          Last modified: January 20, 1990                     }
  8. {                                                              }
  9. {==============================================================}
  10.  
  11. UNIT Finance;
  12.  
  13. {--------------------------------------------------------------}
  14.                           INTERFACE
  15. {--------------------------------------------------------------}
  16.  
  17. USES crt;
  18.  
  19. TYPE
  20.   AmortRecType = RECORD                     { Record type for     }
  21.                    InterestPart,            { results of Amortize }
  22.                    PrincipalPart,           { procedure           }
  23.                    NewBalance : real;
  24.                  END;
  25.  
  26. VAR
  27.   AmortRecord : AmortRecType;
  28.  
  29.  
  30. FUNCTION Form (number : real) : string;
  31. { Function to return a real number as a string
  32.   formatted with a dollar sign and commas }
  33.  
  34. FUNCTION Raise (Number, Power : real) : real;
  35.  
  36. PROCEDURE Amortize (Principal, Payment, InterestRate,
  37.                     PaymentsPerYear : real);
  38. { Procedure to calculate the amortization resulting from
  39.   one payment.  Returns the amount of the payment allocated
  40.   to interest and principal and the resulting new principal
  41.   balance in the AmortRecord global variable - used in a
  42.   FOR loop from 1 to the term of the loan in months to
  43.   generate an amortization table }
  44.  
  45. FUNCTION CalculatePayment (Principal, InterestRate,
  46.                            PaymentsPerYear, Years : real) : real;
  47. { Function to calculate the monthly payment on a loan }
  48.  
  49. FUNCTION CalculatePrincipal (Payment, InterestRate,
  50.                              Years, PaymentsPerYear : real) : real;
  51. { Function to APPROXIMATE the original principal of a loan given
  52.   the other factors - approximate because of real number rounding
  53.   errors }
  54.  
  55. FUNCTION CalculateTerm (Principal, Payment,
  56.                         InterestRate, PaymentsPerYear : real) : real;
  57. { Function to APPROXIMATE the original term of a loan given the other
  58.   factors }
  59.  
  60. FUNCTION CalculateInterestRate (Principal, Payment,
  61.                                 Years, PaymentsPerYear : real) : real;
  62. { Function to APPROXIMATE the original interest rate of a loan given
  63.   the other factors }
  64.  
  65. {--------------------------------------------------------------}
  66.                         IMPLEMENTATION
  67. {--------------------------------------------------------------}
  68.  
  69. FUNCTION Form (number : real) : string;
  70.   VAR
  71.     RoundedNumber : longint;
  72.     CentsPart,
  73.     DollarsPart,
  74.     TempStr : string;
  75.     DotPos : byte;
  76.     OrgLen : byte;
  77.   BEGIN
  78.     Number := Number * 100;
  79.     RoundedNumber := Round (Number);
  80.     Str (RoundedNumber, TempStr);
  81.     DollarsPart := Copy (TempStr, 1, Length (TempStr) - 2);
  82.     CentsPart := Copy (TempStr, Length (TempStr) - 1, 2);
  83.     OrgLen := Length (DollarsPart);
  84.     IF OrgLen > 3 THEN
  85.       BEGIN
  86.         IF OrgLen < 7 THEN
  87.           Insert (',', DollarsPart, Length (DollarsPart) - 2);
  88.         IF OrgLen >= 7 THEN
  89.           BEGIN
  90.             Insert (',', DollarsPart, Length (DollarsPart) - 5);
  91.             Insert (',', DollarsPart, Length (DollarsPart) - 2);
  92.           END;
  93.       END;
  94.     Form := '$' + DollarsPart + '.' + CentsPart;
  95.   END;
  96.  
  97. FUNCTION Raise (Number, Power : real) : real;
  98.   BEGIN
  99.     Raise := Exp (Power*Ln(Number));
  100.   END;
  101.  
  102. PROCEDURE Amortize (Principal, Payment, InterestRate,
  103.                     PaymentsPerYear : real);
  104.   BEGIN
  105.     WITH AmortRecord DO
  106.       BEGIN
  107.         InterestPart := Principal * (InterestRate/100) * (1/PaymentsPerYear);
  108.         PrincipalPart := Payment - InterestPart;
  109.         NewBalance := Principal - PrincipalPart;
  110.       END;
  111.   END;
  112.  
  113. FUNCTION CalculatePayment (Principal, InterestRate,
  114.                            PaymentsPerYear, Years : real) : real;
  115.   VAR
  116.     Numerator,
  117.     Denominator,
  118.     Denominator2 : real;
  119.  
  120.   BEGIN
  121.     InterestRate := InterestRate / 100;
  122.     Numerator := InterestRate*(Principal/PaymentsPerYear);
  123.     Denominator2 := Raise (InterestRate/PaymentsPerYear+1,
  124.                            PaymentsPerYear*Years);
  125.     Denominator := 1 - (1/Denominator2);
  126.     CalculatePayment := Numerator/Denominator;
  127.   END;
  128.  
  129. FUNCTION CalculatePrincipal (Payment, InterestRate,
  130.                              Years, PaymentsPerYear : real) : real;
  131.   VAR
  132.     Denominator : real;
  133.   BEGIN
  134.     InterestRate := InterestRate/100;
  135.     Denominator := Raise (1 + InterestRate/PaymentsPerYear,
  136.                           PaymentsPerYear*Years);
  137.     CalculatePrincipal :=
  138.       ((Payment*PaymentsPerYear)/InterestRate)*(1 - (1/Denominator));
  139.   END;
  140.  
  141. FUNCTION CalculateTerm (Principal, Payment,
  142.                         InterestRate, PaymentsPerYear : real) : real;
  143.   VAR
  144.     Numerator,
  145.     Denominator : real;
  146.   BEGIN
  147.     InterestRate := InterestRate/100;
  148.     Numerator := Ln (1 - ((Principal*InterestRate)/(PaymentsPerYear*Payment)));
  149.     Denominator := Ln (1 + (InterestRate/PaymentsPerYear));
  150.     CalculateTerm := -(Numerator/Denominator)*(1/PaymentsPerYear);
  151.   END;
  152.  
  153. FUNCTION CalculateInterestRate (Principal, Payment,
  154.                                 Years, PaymentsPerYear : real) : real;
  155.   VAR
  156.     LastGuess,
  157.     CurrentGuess,
  158.     NextGuess,
  159.     ComputedPayment,
  160.     Change : real;
  161.     RoundedComputedPayment,
  162.     RoundedPayment  : longint;
  163.  
  164.   BEGIN
  165.     LastGuess := 0;
  166.     NextGuess := 10.0;
  167.     Payment := Payment * 100;
  168.     RoundedPayment := Round (Payment);
  169.  
  170.     REPEAT
  171.       CurrentGuess := NextGuess;
  172.       ComputedPayment := CalculatePayment (Principal, NextGuess,
  173.                                            PaymentsPerYear, Years);
  174.       ComputedPayment := ComputedPayment * 100;
  175.       RoundedComputedPayment := Round (ComputedPayment);
  176.       IF RoundedComputedPayment < RoundedPayment THEN
  177.         BEGIN
  178.           Change := Abs ((CurrentGuess - LastGuess)/2);
  179.           LastGuess := CurrentGuess;
  180.           NextGuess := CurrentGuess + Change;
  181.         END;
  182.       IF RoundedComputedPayment > RoundedPayment THEN
  183.         BEGIN
  184.           Change := Abs ((CurrentGuess - LastGuess)/2);
  185.           LastGuess := CurrentGuess;
  186.           NextGuess := CurrentGuess - Change;
  187.         END;
  188.     UNTIL RoundedComputedPayment = RoundedPayment;
  189.     CalculateInterestRate := CurrentGuess;
  190.   END;
  191.  
  192. END.
  193.